Garbo/Garbo.cdr/mac/hypercrd/xcmd/sprtxtrn.sea/Support Tools eXternals 1.2.5/card_33159.txt

Text File | 1990-11-13 | 12KB | 316 lines

-- card: 33159 from stack: in.5
-- bmap block id: 8199
-- flags: 0000
-- background id: 3858
-- name: FileCreationDate
----- HyperTalk script -----
on HideObjects
  hide cd btn "Try It!"
end HideObjects

on ShowObjects
  show cd btn "Try It!"
end ShowObjects


-- part 1 (button)
-- low flags: 00
-- high flags: A002
-- rect: left=82 top=185 right=219 bottom=175
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 8192
-- line height: 16
-- part name: Try it!
----- HyperTalk script -----
on mouseUp
  global errGlobal
  put FilePath("", "Choose a file please.") into fileName
  if fileName = empty then exit mouseUp
  put FileCreationDate(fileName, "nodialog:errGlobal") into fDate
  if errGlobal Γëá empty then
    answer "Error: ΓÇ£" & errGlobal & "ΓÇ¥"
    put empty into errGlobal
  else
    convert fDate to short date
    answer "ΓÇ£" & fileName & "ΓÇ¥ was created on" && fDate
  end if
end mouseUp




-- part contents for background part 38
----- text -----
14/50

-- part contents for background part 20
----- text -----
FileCreationDate - An XFCN to return the date a file/folder was created

FileCreationDate(pathName, «"noDialog:"errorGlobal»)

This XFCN returns the same date you see in the Finder windows.  The date is in seconds from 1904 format.  Pass this value to convert in order to get it into a readable
(humanly readable) form.


-- part contents for background part 42
----- text -----
{   File:         FileCreationDate.p}
{}
{ FileCreationDate(pathname «,"nodialog"»)                }
{ XFCN to return the creation date for the file/folder         }
{ specified by the path given in the first parameter.       }
{}
{}
{   Written by:      Anup Murarka         Eric Carlson                         }
{               ALINK:  SKEPTIC       ALINK:  cyNic                   }
{                                   CIS:  76004,3356}
{}
{               We are part of the Support Tools Development Group,                                 }
{               Apple Computer, Inc.                                                                          }
{}
{               please DO NOT contact Mac DTS for support of this code!                                }
{}
{               please DO contact the authors for support of this code!                                 }
{}
{               Send comments, bug reports, requests to any of the above                           }
{               E-mail addresses or to:                                                                      }
{}
{                           (one of us)                                                                  }
{                           Apple Computer, Inc.                                                              }
{                           900 E. Hamilton, Ave.                                                          }
{                           Campbell, CA   95008                                                      }
{                           M/S 72-L                                                                         }
{}
{   Copyright:   © 1989, 1990 by Apple Computer, Inc., all rights reserved.                     }
{}
{ written by    : Anup Murarka                                                                           }
{ AppleLink  : Skeptic                                                                                  }
{ modification history                                                                                    }
{          Date              Initials                                    Comments                                   }
{          ----          ------          --------------------------------------------------------  }
{       8/16/89           akm         first written                                                       }
{       5/23/90           ec            removed upper case converion for A/UX compatibility.       }
{                                           Changed version to 1.1                                      }
{}
unit XFCNUnit;

interface

    uses
        HyperXCmd;

    procedure MAIN (paramPtr: XCmdPtr);

implementation

    procedure FileCreationDate (paramPtr: XCmdPtr);
    FORWARD;

    procedure MAIN (paramPtr: XCmdPtr);
    begin
        FileCreationDate(paramPtr);
    end;

    procedure reportToUser (paramPtr: XCmdPtr;
                                    msgStr: str255);
{}
{ report something back to the user.  }
{ the last parameter (optional) to an external may contain }
 { "noDialog" or "noDialog:GlobalName".  GlobalName is the name }
 { of a HyperTalk global variable into which error messages will be }
 { placed.  we've decided to use this approach to avoid confusing }
{ an error message with a valid result being returned from an XFCN. }
{}
        var
            tempStr: str255;
    begin
{check the last param to see if the user requested that}
{ we suppress the error dialog }
        ZeroToPas(paramPtr, paramPtr^.params[paramPtr^.paramCount]^, tempStr);
        UprString(tempStr, true);
        if pos('NODIALOG', tempStr) = 0 then
    { no special error handling specified, throw up a dialog and return the error message }
            begin
                SendCardMessage(paramPtr, concat('answer "', msgStr, '"'));
                paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
            end
        else if (pos(':', tempStr) > 0) then
    { requested global AND noDialog so we fill in the global and return empty }
            begin
                tempStr := copy(tempStr, pos(':', tempStr) + 1, length(tempStr));
                                                        { get the name of the HC global  to fill }
                SetGlobal(paramPtr, tempStr, PasToZero(paramPtr, msgStr));
                                                        { and fill it }
                paramPtr^.returnValue := PasToZero(paramPtr, '');      { return empty }
            end
        else
    { requested noDialog only so we return the error condition as the result }
            paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
    end;     { procedure }

    function AskedForHelp (paramPtr: XCmdPtr;
                                    syntaxMsg: Str255;
                                    copyrightMsg: Str255): boolean;
{   check to see if the user sent a '?' or a '!' as }
{ the only parameter. if so we will respond with }
{ the calling syntax or the copyright/version info }
{ for this external }
{}
        var
            firstStr: str255;
    begin
        askedForHelp := false;
        if paramPtr^.paramCount = 1 then
            begin
                ZeroToPas(paramPtr, paramPtr^.params[1]^, firstStr);
                    { what is the first param? }
                if firstStr = '?' then
                    begin
                        reportToUser(paramPtr, syntaxMsg);
                        askedForHelp := true
                    end  { asked for help }
                else if firstStr = '!' then
                    begin
                        reportToUser(paramPtr, copyRightMsg);
                        askedForHelp := true
                    end;     { asked for copyright info }
            end;     { one parameter passed }
    end;     { function }

    function NumberToString (paramPtr: XCmdPtr;
                                    num: LONGINT): Str255;
{ use the toolbox call rather than HC's }
        var
            tempStr: str255;
    begin
        NumToString(num, tempStr);
        NumberToString := tempStr;
    end;

    function LongToString (paramPtr: XCmdPtr;
                                    num: LONGINT): Str255;
{ why, oh why did dan write this one as a procedure??? }
        var
            tempStr: str255;
    begin
        LongToStr(paramPtr, num, tempStr);
        LongToString := tempStr;
    end;

    procedure reportResError (paramPtr: XCmdPtr;
                                    errorNum: integer);
        var
            errMsg, tempName: str255;
    begin
        case errorNum of                   { what caused the problem? }
            -0:
                errMsg := 'no error.';
            -36:
                errMsg := 'I/O Error.';
            -37:
                errMsg := 'bad file name or volume name.';
            -38:
                errMsg := 'file not open.';
            -39:
                errMsg := 'that file has no resource fork.';
            -42:
                errMsg := 'too many files open.';
            -43:
                errMsg := 'file not found.';
            -45, -54, -61:
                errMsg := 'file locked.';
            -47, -49:
                errMsg := 'file is busy.';
            -53:
                errMsg := 'that volume is not on line.';
            -108:
                errMsg := 'not enough room in heap zone.';
            -120:
                errMsg := 'directory not found.';
            -121:
                errMsg := 'too many working directories open.';
            -127:
                errMsg := 'internal file system error.';
            -192:
                errMsg := 'resource not found.';
            -193:
                errMsg := 'file not found.';
            otherwise
                errMsg := concat('unexpected error #', NumberToString(paramPtr, errorNum));
        end;         { case }

        errMsg := concat('Sorry, ', errMsg);
        reportToUser(paramPtr, errMsg);
        { return the error message }
    end;         { function }

    function getParams (paramPtr: XCmdPtr;
                                    var PathToFile: str255): boolean;
    { function to get the parameters and validate them.  Returns boolean}
    { instructing the main procedure to continue if the parameters passed}
    { are valid.  Also returns syntax messages if requested by the user.}
        var
            numParams: integer;
            syntaxStr, copyrightStr: str255;

    begin
        getParams := true;     {Initially, assume the parameters are valid.}
        syntaxStr := 'FileCreationDate(pathname «, “nodialog”:errGlobal)';
        copyrightStr := '© 1989,1990 Apple Computer, Inc., v.1.1, by Anup Murarka';

        {check that we have the proper number of parameters}
        numParams := paramPtr^.paramCount;
        if (numParams < 1) or (numParams > 2) then
            begin
                getParams := false;
                reportToUser(paramPtr, syntaxStr);
                exit(getParams);
            end;

        if AskedForHelp(paramPtr, syntaxStr, copyrightStr) then
            begin
                getParams := false;
                exit(getParams);
            end;

        { Get first parameter}
        ZeroToPas(paramPtr, paramPtr^.Params[1]^, PathToFile);

    end;     {GetParams}

    procedure FileCreationDate (paramPtr: XCmdPtr);
        var
            getParamsOK: boolean;
            FileName: str255;
            paramBlock: CInfoPBRec;
            errorCode: OSerr;

    begin   { FileCreationDate}
    { fetch and validate the passed parameters}
        getParamsOK := getParams(paramPtr, FileName);
        if not (getParamsOK) then
            exit(FileCreationDate);

    { Initialize the parameter block.  Since we have the full pathname,}
    { no other field is really needed.}
        zeroBytes(paramPtr, @paramBlock, sizeOf(paramBlock));
        paramBlock.ioNamePtr := @FileName;

        errorCode := PBGetCatInfo(@paramBlock, FALSE);
        if errorCode <> noErr then
            begin
                reportResError(paramPtr, errorCode);
                exit(FileCreationDate)
            end;

    { Now prepare the return value.  Use FileName as a temp variable}
        FileName := LongToString(paramPtr, paramBlock.ioFlCrDat);
        paramPtr^.returnValue := PasToZero(paramPtr, FileName);
    end;

end.